open Constant

let _LIBDIRS = ["/usr/lib";"/usr/local/lib"; Filename.concat (try Sys.getenv "HOME" with Not_found -> ".") "lib"]


(** Library directory *)
let libdir =
	let rec loop = function
		| path :: remainder -> 
			  let libpath = Filename.concat path _LIB_FOLDER in 
				if Sys.file_exists libpath && Sys.is_directory libpath then libpath else loop remainder
		| [] -> raise Not_found in
	loop _LIBDIRS


let ask_for_file () =
  let dialog = GWindow.file_chooser_dialog
      ~action:`SELECT_FOLDER
      ~title:"Select project folder"
       () in
  dialog#add_button_stock `CANCEL `CANCEL ;
  dialog#add_select_button_stock `OPEN `OPEN ;
  let filename = 
		begin match dialog#run () with
  	| `OPEN -> dialog#filename
  	| `DELETE_EVENT | `CANCEL -> None
  	end in
  dialog#destroy (); filename
		
(** Make an absolute path for an icon *)
let find_icon name = Filename.concat libdir name

let create_arrow_button ?(width = _ARROW_WIDTH) ~kind  ~packing () =
	let button = GButton.button ~packing () in
	ignore (GMisc.arrow ~kind ~width ~height:_ARROW_HEIGHT ~xpad:2 ~packing:button#add ());
	button;;

let ready_photo = GDraw.pixmap_from_xpm ~file:(find_icon _PHOTO_ICON) ()
let busy_photo = GDraw.pixmap_from_xpm ~file:(find_icon _PHOTO_BUSY_ICON) ()

(** Create a button with a pixmap *)
let create_pixmap_button ~packing xpm_name =
	let button = GButton.button ~packing ~relief:`NONE () in
	let pixmap = GDraw.pixmap_from_xpm ~file:(find_icon xpm_name) () in
	button#set_border_width 0;
	let image = GMisc.pixmap pixmap ~packing:(button#add) () in
	button,image;;

(** This is the area attached to a single camera *)
class camera_zone = fun ~packing -> 
	let box = GPack.vbox ~packing () in
	let label_camera =
		GMisc.label ~text:"No camera" ~packing:(box#pack) () in
	let area = GMisc.drawing_area ~width:_WIN_WIDTH ~height:_WIN_HEIGHT ~packing:(box#pack ~expand:true ~fill:true) () in
	let hbox = GPack.hbox ~packing:box#pack () in
	let button,photo_pixmap = create_pixmap_button ~packing:(hbox#pack ~padding:3 ) _PHOTO_ICON in
	let label =  
		GMisc.label ~text:"" ~packing:(hbox#pack ~expand:true) () in

	let slider = 
		GRange.scale `HORIZONTAL ~update_policy:`DISCONTINUOUS ~digits:0 ~packing:box#pack () in
	
	let w = area#misc#realize (); area#misc#window in

	let drawing = new GDraw.drawable w in
	
	
	object(self)
	  (** The current thumb *)
		val mutable image = GdkPixbuf.create ~width:(_WIN_WIDTH - _BORDER) ~height:(_WIN_HEIGHT - _BORDER) ()
	  (** Image number *) 
		val mutable text = ""
		(** Thumb name *)
		val mutable thumb_name = ""
		(** Callback to change focus *)
		val mutable focus_callback = (fun _ -> None)
		(** Make the camera icon busy *)

		method camera_busy b =
			photo_pixmap#set_pixmap (if b then busy_photo else ready_photo)
		(** Change image number and thumb *)
		method set new_text new_thumb_name = 
			text <- new_text;
			label#set_label text;
			thumb_name <- (match new_thumb_name with None -> "-" | Some v -> v);
			if thumb_name = "-" then GdkPixbuf.fill image 0xffffffffl
			else begin
				let imLoaded = GdkPixbuf.from_file thumb_name in
				let scale_x = float_of_int (GdkPixbuf.get_width image) /. float_of_int (GdkPixbuf.get_width imLoaded) in
				let scale_y = float_of_int (GdkPixbuf.get_height image) /. float_of_int (GdkPixbuf.get_height imLoaded) in
				GdkPixbuf.scale ~dest:image ~scale_x:scale_x ~scale_y:scale_y imLoaded
			end;
			GtkBase.Widget.queue_draw area#coerce#as_widget
		
		method get_state =
			let adj = slider#adjustment in
			let focus_info = adj#value,adj#lower,adj#upper,adj#step_increment in
			image, text, focus_info
		
		method set_state (new_image, new_text, new_focus_info) =
			text <-new_text;
			label#set_label text;
			image <- new_image;
			self#set_focus_info new_focus_info;
			GtkBase.Widget.queue_draw area#coerce#as_widget
		
		(** Change the visible camera name *)
		method set_camera_name name =	label_camera#set_label name
		(** Redraw the content of the thumb image *)
		method redraw _ =
	  	let off = _BORDER / 2 in
  		drawing#put_pixbuf off off image;
			false 
		(** Set-up callback for button take photo *)
		method take_photo callback = button#connect#clicked ~callback:callback
		(** Update the slider information with new focus info. *)
		method set_focus_info (v,min_focus,max_focus,step) =
			let adj = GData.adjustment  ~value:v ~lower:min_focus ~upper:max_focus ~step_incr:step () ~page_size:0.0 in
			slider#set_adjustment adj
	  (** Set the callback used to tune the camera focus *)
		method set_focus_callback (callback : float -> string option) = focus_callback <- callback
		
		method button_take_picture = button 
		method slider = slider
		initializer 
			ignore(GdkPixbuf.fill image 0xffffffffl;
			area#event#connect#expose ~callback:self#redraw);
			let slider_callback () = 
				self#camera_busy true;
				ignore (Glib.Idle.add  
				  (fun () ->
				    let new_focus = slider#adjustment#value in 
			      let opt_thumbname = focus_callback new_focus in
				    self#set (Printf.sprintf "Adjusting %.1fmm" new_focus) opt_thumbname;
				    self#camera_busy false;
						false)) in
			ignore (slider#connect#value_changed slider_callback);
			let drawing_change (ev:GdkEvent.Configure.t) =
				let old_image = image in
				let ow = GdkPixbuf.get_width old_image in
				let oh = GdkPixbuf.get_height old_image in
	  		let w = GdkEvent.Configure.width ev - _BORDER in
		  	let h = GdkEvent.Configure.height ev - _BORDER in
				if (ow <> w ) or (oh <> h) then begin
				  image <- GdkPixbuf.create ~width:w ~height:h ();
				  let scale_x = float_of_int w /. float_of_int ow in
				  let scale_y = float_of_int h /. float_of_int oh in
				  GdkPixbuf.scale ~dest:image ~scale_x:scale_x ~scale_y:scale_y old_image
				end;
		  	true in
			ignore (area#event#connect#configure ~callback:drawing_change)
	end

(** This is the global GUI *)
class ihm() =
  let window = GWindow.window () in
	let quit _ = window#destroy (); (exit 0 : bool) in
	let _ = window#event#connect#delete ~callback:quit in
	let main_vbox = GPack.vbox ~packing:window#add () in
	let menubar = GMenu.menu_bar ~packing:(main_vbox#pack ~expand:false) () in
	let factory = new GMenu.factory ~accel_path:"<BOOKSCANNER>/" menubar in

	let accel_group = factory#accel_group in
	let _  = window#add_accel_group accel_group in
	let box = GPack.table ~columns:3 ~rows:2 ~homogeneous:false ~packing:(main_vbox#pack ~expand:true ~fill:true) () in
		
	let button_up,_ = create_pixmap_button ~packing:(box#attach ~left:0 ~top:0) _PREV_ICON in
	let hbox = GPack.hbox ~packing:(box#attach ~expand:`BOTH ~fill:`BOTH ~left:1 ~top:0) () in
	let button_down,_ = create_pixmap_button ~packing:(box#attach ~left:2 ~top:0) _NEXT_ICON in
	let button_start,_ = create_pixmap_button ~packing:(box#attach ~left:0 ~top:1) _START_ICON in
	let button_take_picture,photo_pixmap = create_pixmap_button ~packing:(box#attach ~left:1 ~top:1) _PHOTO_ICON in 
	let button_end,_ = create_pixmap_button ~packing:(box#attach ~left:2 ~top:1) _END_ICON in
	let thumbL = new camera_zone ~packing:hbox#add  in
	let thumbR = new camera_zone ~packing:hbox#add  in
  let pbar =
    GRange.progress_bar 
		  ~pulse_step:0.01 ()
		  ~packing:(main_vbox#pack ~expand:false) in
	let tooltips = GData.tooltips () in
	let _ =
		tooltips#set_tip button_up#coerce ~text:"Move back two pages (Page Up)";
		tooltips#set_tip button_down#coerce ~text:"Move next two pages (Page Down)";
		tooltips#set_tip button_take_picture#coerce ~text:"Take photos of both pages (B)";
		tooltips#set_tip button_start#coerce ~text:"Go to the begining of the book (Home)";
		tooltips#set_tip button_end#coerce ~text:"Go to the begining of the book (End)";
		tooltips#set_tip thumbL#button_take_picture#coerce ~text:"Take a photo of the Left page (L)";
		tooltips#set_tip thumbR#button_take_picture#coerce ~text:"Take a photo of the Right page (R)";
		tooltips#set_tip thumbL#slider#coerce ~text:"Move the slider to change the zoom of the camera for the left page.";
		tooltips#set_tip thumbR#slider#coerce ~text:"Move the slider to change the zoom of the camera for the right page."
		in
	let do_tell msg = 
		let w = GWindow.dialog ~title:"Warning" ~parent:window ~modal:true ~position:`CENTER_ON_PARENT () in
		ignore (GMisc.label ~text:msg ~ypad:10 ~xpad:20 ~packing:w#vbox#add ());
	  w#add_button_stock `OK `OK;
  	w#set_default_response `OK;
	  ignore (w#run ()); w#destroy () in
	object(self)
	  val mutable callback_picture = (fun _ -> ())
		val mutable callback_move = (fun _ -> ())
		
		(** set-up the callback for the take pictures (both) button *) 
	  method take_picture callback = callback_picture <- callback 

		(** Register callback for changing page *)
		method move callback = callback_move <- callback
		
		(** Change camera name (left) *)
		method set_camera_name_left name = thumbL#set_camera_name name
		
		(** Change camera name (right) *)
		method set_camera_name_right name = thumbR#set_camera_name name
		
		(** Set camera left icon busy *)
		method set_camera_busy_left b = thumbL#camera_busy b
		
		(** Set camera left icon busy *)
		method set_camera_busy_right b = thumbR#camera_busy b
		
		(** Set thumb left *)
		method set_left (i,file) = thumbL#set i file
		
		(** Set thumb right *)
		method set_right (i,file) = thumbR#set i file
		
		(** set focus information from left camera *)
		method set_focus_info_left info = thumbL#set_focus_info info
		
		(** set focus setting callback (left) *)
		method set_focus_callback_left callback = thumbL#set_focus_callback callback
		
		(** set focus information from right camera *)
		method set_focus_info_right info = thumbR#set_focus_info info
		
		(** set focus setting callback (right) *)
	  method set_focus_callback_right callback = thumbR#set_focus_callback callback
		
		(** Set menu *)
		method set_menu title entries = 
			let submenu = factory#add_submenu title in
			let factory = new GMenu.factory ~accel_path:("<BOOKSCANNER " ^ title ^ ">/") ~accel_group submenu in
			List.iter 
			  (function (name, callback, Some key) -> ignore (factory#add_item name ~key:key ~callback:callback)
				        | (name, callback, None) -> ignore (factory#add_item name ~callback:callback)) 
				entries

		(** Show GUI *)
		method show = window#show ()
		
		(** Quit GUI *)
		method quit = ignore (quit ())
		
		(** Display a modal dialog *) 
		method tell msg = do_tell msg; ()
		
		(** Exchange the place of both cameras (left and right) *)
		method swap_cameras =
			let state_left = thumbL#get_state and state_right = thumbR#get_state in
			thumbR#set_state state_left; thumbL#set_state state_right 
				
		(** set the progress indicator *)
		method set_progress i l (kont : unit -> unit) =
			let prog = (float_of_int i) /. (float_of_int l) in
			pbar#set_fraction prog;
  		ignore (Glib.Idle.add (fun () -> kont(); false)) 

		initializer
			let set_busy action b = 
				match action with
				| S_BOTH -> thumbL#camera_busy b; thumbR#camera_busy b
				| S_LEFT -> thumbL#camera_busy b 
				| S_RIGHT -> thumbR#camera_busy b in
			let callback_picture_protected action =
				set_busy action true;
				ignore (Glib.Idle.add  
				  (fun () ->
				    begin try callback_picture action
				    with Failure e -> self#tell ("An error occurred: " ^ e) end; 
				    set_busy action false;
						false)) in
			let callback_move_protected action =
				try callback_move action
				with Failure e -> self#tell ("An error occurred: " ^ e) in
				
			ignore (button_take_picture#connect#clicked ~callback:(fun ()  -> callback_picture_protected S_BOTH)); 
			ignore (thumbL#take_photo (fun () -> callback_picture_protected S_LEFT));
			ignore (thumbR#take_photo (fun () -> callback_picture_protected S_RIGHT));
			ignore (button_up#connect#clicked ~callback:(fun () -> callback_move_protected PREV));
			ignore (button_down#connect#clicked ~callback:(fun () -> callback_move_protected NEXT));
			ignore (button_start#connect#clicked ~callback:(fun () -> callback_move_protected START));
			ignore (button_end#connect#clicked ~callback:(fun () -> callback_move_protected END));
			let key_handler event = 
				let k = GdkEvent.Key.keyval event in
				if k = GdkKeysyms._B then begin callback_picture_protected S_BOTH; true end
				else if k = GdkKeysyms._L then begin callback_picture_protected S_LEFT; true end
				else if k = GdkKeysyms._R then begin callback_picture_protected S_RIGHT; true end 
				else if k = GdkKeysyms._Page_Up then begin callback_move_protected PREV; true end
				else if k = GdkKeysyms._Page_Down then begin callback_move_protected NEXT; true end
				else if k = GdkKeysyms._Home then begin callback_move_protected START; true end
				else if k = GdkKeysyms._End then begin callback_move_protected END; true end
				else false in
			ignore (window#event#connect#key_release ~callback:key_handler)
	end
 
